home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / WINDOWS / WXLSLIB.ARJ / HELP.LSP < prev    next >
Lisp/Scheme  |  1992-02-20  |  4KB  |  109 lines
  1. ;;;;
  2. ;;;; help.lsp XLISP-STAT help functions
  3. ;;;; XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney
  4. ;;;; Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz
  5. ;;;; You may give out copies of this software; for conditions see the file
  6. ;;;; COPYING included with this distribution.
  7. ;;;;
  8.  
  9. (provide "help")
  10.  
  11. ;;;;
  12. ;;;; Help Functions
  13. ;;;;
  14.      
  15. (defun help (&optional s)
  16. "Args: (&optional symbol)
  17. Prints the documentation associated with SYMBOL.  With no argument, 
  18. this function prints the greeting message to beginners."
  19.   (cond 
  20.     ((null s) (princ "***Intro not yet available***"))
  21.     (t (let ((docf (documentation s 'function))
  22.              (docv (documentation s 'variable))
  23.              (doct (documentation s 'type))
  24.              (docs (documentation s 'setf)))
  25.          (unless (or docf docv doct docs)
  26.                  (format t "Sorry, no help available on ~a~%" s))
  27.          (flet ((put-doc (sym type str)
  28.                          (princ sym)
  29.                          (dotimes (i (- *line-length*
  30.                                         (length (string sym))
  31.                                         (length (string type))))
  32.                                   (princ " "))
  33.                          (princ type)
  34.                          (terpri)
  35.                          (princ str)
  36.                          (terpri)))
  37.            (if docf (put-doc s "[function-doc]" docf))
  38.            (if docv (put-doc s "[variable-doc]" docv))
  39.            (if doct (put-doc s "[type-doc]" doct))
  40.            (if docs (put-doc s "[setf-doc]" docs))))))
  41.   nil)
  42.  
  43. (defun help* (sl)
  44. "Args: (string)
  45. Prints the documentation associated with those symbols whose print names
  46. contain STRING as substring.  STRING may be a symbol, in which case the
  47. print-name of that symbol is used."
  48.   (dotimes (i *line-length*) (princ "-"))
  49.   (terpri)
  50.   (dolist (s (mapcar #'intern 
  51.                      (sort-data (mapcar #'string (apropos-list sl)))))
  52.           (help s)
  53.           (dotimes (i *line-length*) (princ "-"))
  54.           (terpri)))
  55.  
  56. ;;;;
  57. ;;;; Object Help Stuff
  58. ;;;;
  59.  
  60. (defmeth *object* :doc-topics ()
  61. "Method args: ()
  62. Returns all topics with documentation for this object."
  63.   (load-help)
  64.   (remove-duplicates 
  65.    (mapcar #'car 
  66.            (apply #'append 
  67.                   (mapcar 
  68.                    #'(lambda (x) 
  69.                        (if (send x :has-slot 'documentation :own t)
  70.                            (send x :slot-value (quote documentation))))
  71.                    (send self :precedence-list))))))
  72.  
  73. (defmeth *object* :documentation (topic &optional (val nil set))
  74. "Method args: (topic &optional val)
  75. Retrieves or sets object documentation for topic."
  76.   (unless set (load-help))
  77.   (if set (send self :internal-doc topic val))
  78.   (let ((val (dolist (i (send self :precedence-list))
  79.                      (let ((val (send i :internal-doc topic))) 
  80.                        (if val (return val))))))
  81.     (when (and (numberp val) (streamp *help-stream*))
  82.           (file-position *help-stream* val)
  83.           (setq val (read *help-stream*)))
  84.     val))
  85.  
  86. (defmeth *object* :delete-documentation (topic)
  87. "Method args: (topic)
  88. Deletes object documentation for TOPIC."
  89.   (setf (slot-value 'documentation)
  90.         (remove :title nil :test #'(lambda (x y) (eql x (first y)))))
  91.   nil)
  92.  
  93. (defmeth *object* :help (&optional topic)
  94. "Method args: (&optional topic)
  95. Prints help message for TOPIC, or genreal help if TOPIC is NIL."
  96.   (if topic 
  97.       (let ((doc (send self :documentation topic)))
  98.         (cond 
  99.           (doc (princ topic) (terpri) (princ doc) (terpri))
  100.           (t (format t "Sorry, no help available on ~a~%" topic))))
  101.       (let ((topics (sort-data (mapcar #'string (send self :doc-topics))))
  102.             (proto-doc (send self :documentation 'proto)))
  103.         (if (send self :has-slot 'proto-name)
  104.         (format t "~s~%" (slot-value 'proto-name)))
  105.         (when proto-doc (princ proto-doc) (terpri))
  106.         (format t "Help is available on the following:~%~%")
  107.         (dolist (i topics) (princ i) (princ " "))
  108.         (terpri))))
  109.